       D999-DB2-DATE-FORMAT-CHECK.
      *   < THIS ROUTINE CHECK THE FORMAT OF DATE, IN DB2 USA FORMAT
      *     THE INPUT SHOULD BE PLACED IN A WORKING FIELD
      *     THE WORKING STORAGE DEFININTION ARE IN COPY MEMBER
      *            C108WDTE.
      *
      *     05  W0002-DB2-DATE.
      *         10  W0002-DB2-MM     PIC  X(02).
      *         10  W0002-DB2-DASH1  PIC  X(01).
      *         10  W0002-DB2-DD     PIC  X(02).
      *         10  W0002-DB2-DASH2  PIC  X(01).
      *         10  W0002-DB2-CC     PIC  X(02).
      *         10  W0002-DB2-YY     PIC  X(02).
      * 05  W0002-DB2-DATE-NUM
      *         10  W0002-DB2-MM-DSP PIC  9(02) DISPLAY.
      *         10  W0002-DB2-MM-NUM PIC  9(02).
      *         10  W0002-DB2-DD-DSP PIC  9(02) DISPLAY.
      *         10  W0002-DB2-DD-NUM PIC  9(02).
      *         10  W0002-DB2-YY-DSP PIC  9(02) DISPLAY.
      *         10  W0002-DB2-YY-NUM PIC  9(02).
      *         10  W0002-DB2-YY-RLT PIC  9(02).
      *         10  W0002-DB2-YY-RMD PIC  9(02).
      *         10  W0002-DB2-CC-DSP PIC  9(02) DISPLAY.
      *         10  W0002-DB2-CC-NUM PIC  9(02).

           IF (   W0002-DB2-DASH1 NOT = '/'
               OR W0002-DB2-DASH2 NOT = '/'
              )
               SET  ERRORS        TO   TRUE
               MOVE W9999-MSG-078 TO   M-MSG-24I
           END-IF.

           IF NO-ERRORS
              IF (    W0002-DB2-MM NOT NUMERIC
                  OR  W0002-DB2-DD NOT NUMERIC
                  OR  W0002-DB2-CC NOT NUMERIC
                  OR  W0002-DB2-YY NOT NUMERIC
                 )
                  SET  ERRORS        TO   TRUE
                  MOVE W9999-MSG-078 TO   M-MSG-24I
              END-IF
           END-IF.

           IF NO-ERRORS
              MOVE W0002-DB2-MM     TO  W0002-DB2-MM-DSP
              MOVE W0002-DB2-MM-DSP TO  W0002-DB2-MM-NUM
              MOVE W0002-DB2-DD     TO  W0002-DB2-DD-DSP
              MOVE W0002-DB2-DD-DSP TO  W0002-DB2-DD-NUM
              MOVE W0002-DB2-YY     TO  W0002-DB2-YY-DSP
              MOVE W0002-DB2-YY-DSP TO  W0002-DB2-YY-NUM
              MOVE W0002-DB2-CC     TO  W0002-DB2-CC-DSP
              MOVE W0002-DB2-CC-DSP TO  W0002-DB2-CC-NUM
              IF (    W0002-DB2-MM-NUM < 1
                  OR  W0002-DB2-MM-NUM > 12
                 )
                  SET  ERRORS        TO   TRUE
                  MOVE W9999-MSG-079 TO   M-MSG-24I
              END-IF
           END-IF.

           IF NO-ERRORS
      *      <  THE YEAR ARE LIMITED TO 20 & 21 CENTURY, THE PROJECTS
      *          BEFORE THE TIME FRAME (PRE SEMICONDUCTOR AGE)
      *          AND AFTER THE TIME FRAME (THERE WILL BE OTHER SYSTEMS
      *          HANDLE THIS PROBLEM), LET PROGRAMMERS/ROBOTS 100 YEARS
      *          LATER CHANGE THIS
      *      >
              IF  (     W0002-DB2-CC-NUM < 19
                   OR   W0002-DB2-CC-NUM > 20
                  )
                  SET  ERRORS        TO   TRUE
                  MOVE W9999-MSG-081 TO   M-MSG-24I
              END-IF
           END-IF.

           IF NO-ERRORS
              IF (    W0002-DB2-DD-NUM < 1
                  OR  W0002-DB2-DD-NUM > 31
                 )
                  SET  ERRORS        TO   TRUE
                  MOVE W9999-MSG-080 TO   M-MSG-24I
              END-IF
           END-IF.

           IF NO-ERRORS
              IF (    ( W0002-DB2-MM-NUM = 4 OR 6 OR 11 )
                  AND   W0002-DB2-DD-NUM = 31
                 )
                  SET  ERRORS        TO   TRUE
                  MOVE W9999-MSG-080 TO   M-MSG-24I
              END-IF
           END-IF.

           IF NO-ERRORS
              IF W0002-DB2-MM-NUM = 2

                 DIVIDE       W0002-DB2-YY-NUM
                    BY        4
                    GIVING    W0002-DB2-YY-RLT
                    REMAINDER W0002-DB2-YY-RMD
                 END-DIVIDE
      *         < IN SKIP YEAR, IT ALLOW FEB. 29 >
                 IF (   W0002-DB2-DD-NUM > 29
                     OR (    W0002-DB2-YY-RMD NOT = 0
                         AND W0002-DB2-DD-NUM     = 29
                    )   )
                    SET  ERRORS        TO   TRUE
                    MOVE W9999-MSG-080 TO   M-MSG-24I
                 END-IF
              END-IF
           END-IF.

